;;;============================================================
;;;
;;; Subject: Simplicial Complexes to Simplicial Sets
;;;
;;;------------------------------------------------------------
;;;
;;; Jónathan Heras Vicente
;;; Beginning date: 21-10-09
;;;
;;;============================================================



(defun simplicial-complex-bspn (simplicial-complex)
  (let ((bspn nil))
    (dolist (temp simplicial-complex)
      (if (equal bspn nil)
          (setf bspn temp)
        (if (and (not (equal nil temp))
                 (equal :less (l-cmpr temp bspn)))
            (setf bspn temp)
          nil)))
    bspn))


(defun simplicial-complex-basis (simplicial-complex)
  (flet ((rslt (dmns)
	   (declare (fixnum dmns))
	   (remove-if #'(lambda (item) 
                     (not (= (length item) (1+ dmns)))) 
                 simplicial-complex)))
    (the basis #'rslt)))


(defun delete-element-of-position-aux (list index n)
  (if (equal index n)
      (cdr list)
    (cons (car list) (delete-element-of-position-aux (cdr list) index (1+ n))
          )                
    )
  )

(defun remove-position (s ls)
  (cond ((= s 0) (cdr ls))
        (t (cons (car ls) (remove-position (1- s) (cdr ls))))))


(defun simplicial-complex-face ()
  (flet ((rslt (indx dmns2 gmsm)
               (if (equal dmns2 0)
                   nil
                 (absm 0 (remove-position indx gmsm))
                )))
         (the face #'rslt)))



(defun ss-from-sc (simplicial-complex)
  (build-smst
     :cmpr #'l-cmpr
     :basis (simplicial-complex-basis simplicial-complex)
     :bspn (simplicial-complex-bspn simplicial-complex)
     :face (simplicial-complex-face)
     :bndr-strt :gnrt
     :orgn `(ss-from-sc ,simplicial-complex)
     )
  )

#|
Torus:

(ss-from-sc '((0 1 3)
 (0 1)
 (0 1 5)
 (0 2 4)
 (0 2)
 (0 2 6)
 (0 6)
 (0 3)
 (0 3 6)
 (0)
 (0 5)
 (0 4)
 (0 4 5)
 (1 5)
 (1 2 5)
 (2 6)
 (1 2)
 (1 2 6)
 (1 3)
 (1 3 4)
 (1)
 (1 6)
 (1 4)
 (1 4 6)
 (3 4)
 (2 4)
 (2 3 4)
 (2)
 (2 5)
 (2 3)
 (2 3 5)
 (3)
 (3 6)
 (3 5)
 (3 5 6)
 NIL (6)
 (5)
 (5 6)
 (4)
 (4 6)
 (4 5)
 (4 5 6)))

|#
